home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MENU_UTL / BMENU / BMENUT1.PAS < prev   
Pascal/Delphi Source File  |  1990-09-07  |  4KB  |  156 lines
  1. program BMENUT1;    { John Haluska, CIS 74000,1106          Turbo Pascal 5.5 }
  2.  
  3. { Demo program for BMenu unit which shows how to use the MItem and MMenu
  4.   objects to generate Lotus style horizontal and vertical bar menus. }
  5.  
  6. uses
  7.   Crt,BMenu;
  8.  
  9. type
  10.  
  11.   HeapStat = object     {Monitor heap usage}
  12.     HeapStart,HeapIncrMax : longint;
  13.     procedure Init;
  14.     procedure GetHeapUsed;
  15.     function HeapNow : longint;
  16.   end;
  17.  
  18. procedure HeapStat.Init;
  19. begin
  20.   HeapStart := MemAvail;
  21.   HeapIncrMax := 0;
  22. end;
  23.  
  24. procedure HeapStat.GetHeapUsed;
  25. var
  26.   HeapIncr : longint;
  27. begin
  28.   HeapIncr := HeapStart - MemAvail;
  29.   if HeapIncrMax < HeapIncr then HeapIncrMax := HeapIncr
  30. end;
  31.  
  32. function HeapStat.HeapNow : longint;
  33. begin
  34.   HeapNow := MemAvail;
  35. end;
  36.  
  37. var
  38.   OldTextAttr : byte;
  39.   Hs : HeapStat;
  40.  
  41. procedure SubMenuA;
  42. var
  43.   Ms : MMenuPtr;
  44.   Ch : char;
  45. begin
  46.   Ch := '2';
  47.   New(Ms,Init('1234Q',Red*16 + LightGray));
  48.   Ms^.Append(New(MItemPtr,Init(5,9, ' 1 Item ')));
  49.   Ms^.Append(New(MItemPtr,Init(5,10,' 2 Item ')));
  50.   Ms^.Append(New(MItemPtr,Init(5,11,' 3 Item ')));
  51.   Ms^.Append(New(MItemPtr,Init(5,12,' 4 Item ')));
  52.   Ms^.Append(New(MItemPtr,Init(5,13,'  Quit  ')));
  53.   Hs.GetHeapUsed;
  54.   repeat
  55.     Ch := Ms^.MenuPick(Ch);
  56.     TextAttr := OldTextAttr;
  57.     GoToXY(2,20);
  58.     if (Ch = 'Q') or (Ch = #27) then
  59.       Write(' ':70)
  60.     else
  61.       Write('Char ',Ch,' returned.  Select "Quit" or Esc to exit.',' ':25);
  62.   until (Ch = 'Q') or (Ch = #27);
  63.   TextAttr := OldTextAttr;
  64.   Dispose(Ms,EraseMenu);
  65. end;
  66.  
  67. procedure SubMenuB;
  68. var
  69.   Ms : MMenuPtr;
  70.   Ch : char;
  71. begin
  72.   Ch := 'G';
  73.   New(Ms,Init('AOGP',LightGray*16 + Green));
  74.   Ms^.Append(New(MItemPtr,Init(15,9,' Apples  ')));
  75.   Ms^.Append(New(MItemPtr,Init(15,9,' Oranges ')));
  76.   Ms^.Append(New(MItemPtr,Init(15,9,' Grapes  ')));
  77.   Ms^.Append(New(MItemPtr,Init(15,9,' Peaches ')));
  78.   Hs.GetHeapUsed;
  79.   repeat
  80.     Ch := Ms^.MenuPick(Ch);
  81.     TextAttr := OldTextAttr;
  82.     GoToXY(2,20);
  83.     if Ch = #27 then
  84.       Write(' ':70)
  85.     else
  86.       Write('Char ',Ch,' returned.  Esc to exit.',' ':45);
  87.   until Ch = #27;
  88.   TextAttr := OldTextAttr;
  89.   Dispose(Ms,EraseMenu);
  90. end;
  91.  
  92. procedure SubMenuC;
  93. var
  94.   Ms : MMenuPtr;
  95.   Ch : char;
  96. begin
  97.   Ch := '2';
  98.   New(Ms,Init('TDHQ',Black*16 + Green));
  99.   Ms^.Append(New(MItemPtr,Init(25,9,  ' Tom   ')));
  100.   Ms^.Append(New(MItemPtr,Init(35,9,' Dick  ')));
  101.   Ms^.Append(New(MItemPtr,Init(25,11,' Harry ')));
  102.   Ms^.Append(New(MItemPtr,Init(35,11,' Quit ')));
  103.   Hs.GetHeapUsed;
  104.   repeat
  105.     Ch := Ms^.MenuPick(Ch);
  106.     TextAttr := OldTextAttr;
  107.     GoToXY(2,20);
  108.     if (Ch = #27) or (Ch = 'Q') then
  109.       Write(' ':70)
  110.     else
  111.       Write('Char ',Ch,' returned.  Select Quit or Esc to exit.',' ':45);
  112.   until (Ch = #27) or (Ch = 'Q');
  113.   TextAttr := OldTextAttr;
  114.   Dispose(Ms,EraseMenu);
  115. end;
  116.  
  117. procedure MainMenu;
  118. var
  119.   Mm : MMenuPtr;
  120.   Ch : char;
  121. begin
  122.   Ch := 'B';
  123.   New(Mm,Init('ABCQ',Blue*16 + LightGray));
  124.   Mm^.Append(New(MItemPtr,Init(5,5, ' A Item ')));
  125.   Mm^.Append(New(MItemPtr,Init(15,5,' B Item ')));
  126.   Mm^.Append(New(MItemPtr,Init(25,5,' C Item ')));
  127.   Mm^.Append(New(MItemPtr,Init(35,5,'  Quit  ')));
  128.   Hs.GetHeapUsed;
  129.   repeat
  130.     Ch := Mm^.MenuPick(Ch);       {Initial select is previous select}
  131.     TextAttr := OldTextAttr;
  132.     GoToXY(2,20);
  133.     Write('Char ',Ch,' returned.',' ':60);
  134.     case Ch of
  135.       'A' : SubMenuA;
  136.       'B' : SubMenuB;
  137.       'C' : SubMenuC;
  138.       'Q' : ;
  139.     end;
  140.   until (Ch = 'Q') or (Ch = #27);
  141.   Dispose(Mm,Done);    { Deallocate heap memory }
  142. end;
  143.  
  144. begin
  145.   ClrScr;
  146.   Hs.Init;
  147.   Writeln(#13,#10,' Bar menu demo.  Cursor/Enter keys or 1st letter ',
  148.                      'selects the menu item.  ',#13,#10,
  149.                      ' Esc cancels selection and exits menu.');
  150.   OldTextAttr := TextAttr;
  151.   MainMenu;
  152.   GoToXY(2,20);
  153.   Write('Heap Bytes Before: ',Hs.HeapStart,'  After: ',Hs.HeapNow,
  154.                                   '  Max Used: ',Hs.HeapIncrMax,' ':20);
  155.   TextAttr := OldTextAttr;
  156. end.